home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue54 / Alfresco / AACrypt.pas next >
Pascal/Delphi Source File  |  1999-12-12  |  13KB  |  370 lines
  1. {*********************************************************}
  2. {* AACrypt                                               *}
  3. {* Copyright (c) Julian M Bucknall 1998-2000             *}
  4. {* All rights reserved.                                  *}
  5. {*********************************************************}
  6. {* Algorithms Alfresco simulated annealing unit          *}
  7. {*********************************************************}
  8.  
  9. {Note: this unit is released as freeware. In other words, you are free
  10.        to use this unit in your own applications, however I retain all
  11.        copyright to the code. JMB}
  12.  
  13. unit AACrypt;
  14.  
  15. interface
  16.  
  17. uses
  18.   SysUtils,
  19.   Classes;
  20.  
  21. type
  22.   TaaADFGVXTable = string[36];
  23.  
  24. procedure AACaesarCipher(aEncrypt   : boolean;
  25.                          N          : integer;
  26.                          aInStream  : TStream;
  27.                          aOutStream : TStream);
  28.  
  29. procedure AAVigenereCipher(aEncrypt   : boolean;
  30.                            aKey       : string;
  31.                            aInStream  : TStream;
  32.                            aOutStream : TStream);
  33.  
  34. function AAGenADFGVXTable : TaaADFGVXTable;
  35.  
  36. procedure AAADFGVXCipher(aEncrypt   : boolean;
  37.                          aKey       : string;
  38.                    const aSubstTable: TaaADFGVXTable;
  39.                          aInStream  : TStream;
  40.                          aOutStream : TStream);
  41.  
  42. procedure AAXORCipher(aKey       : PByteArray;
  43.                       aKeyLen    : integer;
  44.                       aInStream  : TStream;
  45.                       aOutStream : TStream);
  46.  
  47.  
  48. implementation
  49.  
  50. {====================================================================}
  51. procedure AACaesarCipher(aEncrypt   : boolean;
  52.                          N          : integer;
  53.                          aInStream  : TStream;
  54.                          aOutStream : TStream);
  55. var
  56.   BytesRead : longint;
  57.   i         : integer;
  58.   Ch        : byte;
  59.   Buf       : array [0..255] of byte;
  60. begin
  61.   {force N in range 0..25}
  62.   N := N mod 26;
  63.   if (N < 0) then
  64.     inc(N, 26);
  65.   if not aEncrypt then
  66.     N := 26 - N;
  67.   {read through the input stream in blocks, encrypt the block, and
  68.    write it to the output stream--only convert A-Z and a-z}
  69.   BytesRead := aInStream.Read(Buf, sizeof(Buf));
  70.   while (BytesRead > 0) do begin
  71.     for i := 0 to pred(BytesRead) do begin
  72.       Ch := Buf[i];
  73.       if ((ord('A') <= Ch) and (Ch <= ord('Z'))) then
  74.         Buf[i] := ((Ch - ord('A') + N) mod 26) + ord('A')
  75.       else if ((ord('a') <= Ch) and (Ch <= ord('z'))) then
  76.         Buf[i] := ((Ch - ord('a') + N) mod 26) + ord('a')
  77.     end;
  78.     aOutStream.Write(Buf, BytesRead);
  79.     BytesRead := aInStream.Read(Buf, sizeof(Buf));
  80.   end;
  81. end;
  82. {====================================================================}
  83.  
  84.  
  85. {====================================================================}
  86. procedure AAVigenereCipher(aEncrypt   : boolean;
  87.                            aKey       : string;
  88.                            aInStream  : TStream;
  89.                            aOutStream : TStream);
  90. var
  91.   BytesRead : longint;
  92.   i, j      : integer;
  93.   Ch        : byte;
  94.   Buf       : array [0..255] of byte;
  95.   OutBuf    : array [0..255] of byte;
  96.   KeyValues : array [0..255] of byte;
  97.   KeyLen    : integer;
  98.   KeyInx    : integer;
  99. begin
  100.   {the Vigenere cipher is for uppercase alphabetic letters only; in
  101.    calculating the key values assume the key is in such a state}
  102.   KeyLen := 0;
  103.   for i := 1 to length(aKey) do
  104.     if ('a' <= aKey[i]) and (aKey[i] <= 'z') then begin
  105.       KeyValues[KeyLen] := ord(aKey[i]) - ord('a');
  106.       inc(KeyLen);
  107.     end
  108.     else if ('A' <= aKey[i]) and (aKey[i] <= 'Z') then begin
  109.       KeyValues[KeyLen] := ord(aKey[i]) - ord('A');
  110.       inc(KeyLen);
  111.     end;
  112.   if not aEncrypt then
  113.     for i := 0 to pred(KeyLen) do
  114.       KeyValues[i] := 26 - KeyValues[i];
  115.   {read through the input stream in blocks, encrypt the block, and
  116.    write it to the output stream--only convert and write A-Z and a-z}
  117.   KeyInx := 0;
  118.   BytesRead := aInStream.Read(Buf, sizeof(Buf));
  119.   j := 0;
  120.   while (BytesRead > 0) do begin
  121.     for i := 0 to pred(BytesRead) do begin
  122.       Ch := Buf[i];
  123.       if ((ord('A') <= Ch) and (Ch <= ord('Z'))) then begin
  124.         OutBuf[j] := ((Ch - ord('A') + KeyValues[KeyInx]) mod 26) + ord('A');
  125.         inc(j);
  126.         KeyInx := (KeyInx + 1) mod KeyLen;
  127.       end
  128.       else if ((ord('a') <= Ch) and (Ch <= ord('z'))) then begin
  129.         OutBuf[j] := ((Ch - ord('a') + KeyValues[KeyInx]) mod 26) + ord('A');
  130.         inc(j);
  131.         KeyInx := (KeyInx + 1) mod KeyLen;
  132.       end;
  133.     end;
  134.     aOutStream.Write(OutBuf, j);
  135.     BytesRead := aInStream.Read(Buf, sizeof(Buf));
  136.     j := 0;
  137.   end;
  138. end;
  139. {====================================================================}
  140.  
  141.  
  142. {====================================================================}
  143. procedure AAADFGVXCipher(aEncrypt   : boolean;
  144.                          aKey       : string;
  145.                    const aSubstTable: TaaADFGVXTable;
  146.                          aInStream  : TStream;
  147.                          aOutStream : TStream);
  148. const
  149.   ADFGVX : array [0..5] of char = 'ADFGVX';
  150. var
  151.   BytesRead : longint;
  152.   i, j      : integer;
  153.   Ch        : char;
  154.   Buf       : array [0..255] of char;
  155.   DblBuf    : array [0..511] of char;
  156.   CleanKey  : string;
  157.   KeyLen    : integer;
  158.   KeyInx    : integer;
  159.   PosCh     : integer;
  160.   MinInx    : integer;
  161.   ColLen    : integer;
  162.   Row, Col  : integer;
  163.   SubstTextSize : longint;
  164.   InStreamSize  : longint;
  165.   MemStream     : TMemoryStream;
  166. begin
  167.   {clean up the key so that it consists only of unique uppercase
  168.    characters}
  169.   CleanKey := '';
  170.   for i := 1 to length(aKey) do begin
  171.     Ch := upcase(aKey[i]);
  172.     if ('A' <= Ch) and (Ch <= 'Z') then
  173.       if (Pos(Ch, CleanKey) = 0) then
  174.         CleanKey := CleanKey + Ch;
  175.   end;
  176.   {===ENCRYPTION===}
  177.   if aEncrypt then begin
  178.     {read the entire input stream, converting into letterpairs into a
  179.      temporary stream}
  180.     MemStream := TMemoryStream.Create;
  181.     try
  182.       BytesRead := aInStream.Read(Buf, sizeof(Buf));
  183.       while (BytesRead > 0) do begin
  184.         j := 0;
  185.         for i := 0 to pred(BytesRead) do begin
  186.           Ch := upcase(Buf[i]);
  187.           if (('A' <= Ch) and (Ch <= 'Z')) or
  188.              (('0' <= Ch) and (Ch <= '9')) then begin
  189.             PosCh := Pos(Ch, aSubstTable) - 1;
  190.             DblBuf[j] := ADFGVX[PosCh div 6];
  191.             DblBuf[j+1] := ADFGVX[PosCh mod 6];
  192.             inc(j, 2);
  193.           end;
  194.         end;
  195.         MemStream.Write(DblBuf, j);
  196.         BytesRead := aInStream.Read(Buf, sizeof(Buf));
  197.       end;
  198.       {now read the letters in each column according to the order of
  199.        the letters in the cleaned key}
  200.       KeyLen := length(CleanKey);
  201.       for KeyInx := 1 to KeyLen do begin
  202.         {find the smallest letter in the key, this is the column we'll
  203.          be reading next}
  204.         MinInx := 1;
  205.         for i := 2 to KeyLen do
  206.           if (CleanKey[i] < CleanKey[MinInx]) then
  207.             MinInx := i;
  208.         CleanKey[MinInx] := #127; {so we don't see it again}
  209.         dec(MinInx); {it's easier with a 0-based number}
  210.  
  211.         {starting off with the MinInx'th letter in the temporary
  212.          stream, copy it and every KeyLen'th letter after that to the
  213.          output stream}
  214.         SubstTextSize := MemStream.Size;
  215.         PosCh := MinInx;
  216.         j := 0;
  217.         while (PosCh < SubstTextSize) do begin
  218.           MemStream.Position := PosCh;
  219.           inc(PosCh, KeyLen);
  220.           MemStream.Read(DblBuf[j], 1);
  221.           inc(j);
  222.           if (j = sizeof(DblBuf)) then begin
  223.             aOutStream.Write(DblBuf, sizeof(DblBuf));
  224.             j := 0;
  225.           end;
  226.         end;
  227.         if (j > 0) then
  228.           aOutStream.Write(DblBuf, j);
  229.       end;
  230.     finally
  231.       MemStream.Free;
  232.     end;
  233.   end
  234.   {===DECRYPTION===}
  235.   else begin
  236.     {first create the memory stream we'll use as an intermediary, set
  237.      its size to the size of the input stream}
  238.     InStreamSize := aInStream.Size;
  239.     MemStream := TMemoryStream.Create;
  240.     try
  241.       MemStream.SetSize(InStreamSize);
  242.       {now read the letters in each column according to the order of
  243.        the letters in the cleaned key}
  244.       KeyLen := length(CleanKey);
  245.       for KeyInx := 1 to KeyLen do begin
  246.         {find the smallest letter in the key, this is the column we'll
  247.          be reading next}
  248.         MinInx := 1;
  249.         for i := 2 to KeyLen do
  250.           if (CleanKey[i] < CleanKey[MinInx]) then
  251.             MinInx := i;
  252.         CleanKey[MinInx] := #127; {so we don't see it again}
  253.         dec(MinInx); {it's easier with a 0-based number}
  254.  
  255.         {calculate the length of this column}
  256.         ColLen := InStreamSize div KeyLen;
  257.         if ((InStreamSize - (ColLen * KeyLen)) > MinInx) then
  258.           inc(ColLen);
  259.  
  260.         {copy the column from the input stream to the temporary
  261.          stream, starting off by copying to the MinInx'th letter in
  262.          the temporary stream, and every KeyLen'th letter after that;
  263.          we stop at the end of the column}
  264.         PosCh := MinInx;
  265.         while (ColLen > 0) do begin
  266.           if (ColLen > sizeof(Buf)) then
  267.             BytesRead := aInStream.Read(Buf, sizeof(Buf))
  268.           else
  269.             BytesRead := aInStream.Read(Buf, ColLen);
  270.           dec(ColLen, BytesRead);
  271.           for i := 0 to pred(BytesRead) do begin
  272.             MemStream.Position := PosCh;
  273.             inc(PosCh, KeyLen);
  274.             MemStream.Write(Buf[i], 1);
  275.           end;
  276.         end;
  277.       end;
  278.       {now read the temporary stream as letter pairs, converting them
  279.        into the original characters for the output stream}
  280.       MemStream.Position := 0;
  281.       BytesRead := MemStream.Read(DblBuf, sizeof(DblBuf));
  282.       j := 0;
  283.       Row := 0;
  284.       Col := 0;
  285.       while (BytesRead > 0) do begin
  286.         for i := 0 to pred(BytesRead) do begin
  287.           if not Odd(i) then begin
  288.             case DblBuf[i] of
  289.               'A' : Row := 0;
  290.               'D' : Row := 1;
  291.               'F' : Row := 2;
  292.               'G' : Row := 3;
  293.               'V' : Row := 4;
  294.               'X' : Row := 5;
  295.             end;
  296.             case DblBuf[i+1] of
  297.               'A' : Col := 0;
  298.               'D' : Col := 1;
  299.               'F' : Col := 2;
  300.               'G' : Col := 3;
  301.               'V' : Col := 4;
  302.               'X' : Col := 5;
  303.             end;
  304.             Buf[j] := aSubstTable[Row * 6 + Col + 1];
  305.             inc(j);
  306.             if (j = sizeof(Buf)) then begin
  307.               aOutStream.Write(Buf, sizeof(Buf));
  308.               j := 0;
  309.             end;
  310.           end;
  311.         end;
  312.         if (j > 0) then
  313.           aOutStream.Write(Buf, j);
  314.         BytesRead := MemStream.Read(DblBuf, sizeof(DblBuf));
  315.       end;
  316.     finally
  317.       MemStream.Free;
  318.     end;
  319.   end;
  320. end;
  321. {--------}
  322. function AAGenADFGVXTable : TaaADFGVXTable;
  323. var
  324.   i, j : integer;
  325.   Ch   : char;
  326. begin
  327.   {set the result value to the letters plus digits}
  328.   Result := 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789';
  329.   {now shuffle the characters in the result}
  330.   for i := length(Result) downto 2 do begin
  331.     j := Random(i) + 1;
  332.     if (i <> j) then begin
  333.       Ch := Result[i];
  334.       Result[i] := Result[j];
  335.       Result[j] := Ch;
  336.     end;
  337.   end;
  338. end;
  339. {====================================================================}
  340.  
  341. {====================================================================}
  342. procedure AAXORCipher(aKey       : PByteArray;
  343.                       aKeyLen    : integer;
  344.                       aInStream  : TStream;
  345.                       aOutStream : TStream);
  346. var
  347.   Buf    : array [0..1023] of byte;
  348.   KeyInx : integer;
  349.   i      : integer;
  350.   BytesRead : longint;
  351. begin
  352.   {read through the input stream in blocks, XOR the block with the key
  353.    and write it to the output stream}
  354.   if (aKey = nil) or (aKeyLen = 0) then
  355.     raise Exception.Create('Cannot encrypt with XOR: the key is missing');
  356.   KeyInx := 0;
  357.   BytesRead := aInStream.Read(Buf, sizeof(Buf));
  358.   while (BytesRead > 0) do begin
  359.     for i := 0 to pred(BytesRead) do begin
  360.       Buf[i] := Buf[i] xor aKey^[KeyInx];
  361.       KeyInx := (KeyInx + 1) mod aKeyLen;
  362.     end;
  363.     aOutStream.Write(Buf, BytesRead);
  364.     BytesRead := aInStream.Read(Buf, sizeof(Buf));
  365.   end;
  366. end;
  367. {====================================================================}
  368.  
  369. end.
  370.